www.gusucode.com > 落叶冰点万能企业网站内容管理系统 V9.1 > 落叶冰点万能企业网站内容管理系统 V9.1\code\inc\bbs-b\reg.asp

    <!--#include file="md5.asp"--><%














	'****************************************************
	'参数说明
	  'Subject     : 邮件标题
	  'Email       : 收件人邮件地址
	  'Content     : 邮件内容
      'is_for_qiye_mail   企业子系统不?
	'****************************************************
	
	is_for_qiye_mail=0
	  Public Function SendMailb(Subject, Email, Content)
	  '                        
	   On Error Resume Next
	   
	   SendMailb="OK"
	   
	   if is_for_qiye_mail=1 then
	   biao2="[ND_sys]"
	   

set rs22t=server.CreateObject("adodb.recordset")
rs22t.open "select top 1 * from "&biao2&" where type='config_settings_qiye'",myconn,1,1
else
set rs22t=server.CreateObject("adodb.recordset")
rs22t.open "select top 1 * from "&biao2&" where type='config_settings'",myconn,1,1
end if

     ddd1tt=rs22t("data")
      dddd12tt=split(ddd1tt,"|")
	   SiteNamexx=cstr(trim(dddd12tt(2)&" "))
	   comtype=cstr(dddd12tt(7))
       if comtype="0" then
	   SendMailb ="not_suputted"
 exit function
 end if
 LoginName=cstr(trim(dddd12tt(10)&" "))
 LoginPass=cstr(trim(dddd12tt(11)&" ")) 
 MailAddress=cstr(trim(dddd12tt(9)&" ")) 
 Fromer=cstr(trim(dddd12tt(8)&" "))
	   
	if comtype="1" then
	
		  Set jmail = Server.CreateObject("JMAIL.Message") '建立发送邮件的对象
			jmail.silent = true '屏蔽例外错误，返回FALSE跟TRUE两值j
			jmail.Charset = "GB2312" '邮件的文字编码为国标
			jmail.ContentType = "text/html" '邮件的格式为HTML格式
			jmail.AddRecipient Email '邮件收件人的地址
			jmail.From = Fromer '发件人的E-MAIL地址
			jmail.FromName = SiteNamexx
			  If LoginName <> "" And LoginPass <> "" Then
				JMail.MailServerUserName = LoginName '您的邮件服务器登录名
				JMail.MailServerPassword = LoginPass '登录密码
			  End If
		If Err Then

SendMailb ="not_suputted"
 exit function
 end if
			jmail.Subject = Subject '邮件的标题 
			JMail.Body = Content
			JMail.Priority = 1'邮件的紧急程序，1 为最快，5 为最慢， 3 为默认值
			jmail.Send(MailAddress) '执行邮件发送（通过邮件服务器地址）
			jmail.Close() '关闭对象
		Set JMail = Nothing
		If Err Then
			SendMailb = "False"
			Err.Clear
		Else
			SendMailb = "OK"
		End If
	  Exit function 
	  
	  end if



	if comtype="2" then
	Set objCDOMail = Server.CreateObject("CDONTS.NewMail")
	objCDOMail.From = Fromer  '邮件地址
	objCDOMail.To = Email
	objCDOMail.Subject = Subject
	objCDOMail.BodyFormat = 0 
	objCDOMail.MailFormat = 0 
	objCDOMail.Body = Content
	If Err <> 0 Then
		SendMailb="not_suputted"
	Else
		objCDOMail.Send
		If Err <> 0 Then
			SendMailb="False"
		Else
			SendMailb="OK"
		End If
	End If
	Set objCDOMail = Nothing
exit function
end if


	if comtype="3" then

	Set Mailer=Server.CreateObject("Persits.MailSender") 
	Mailer.Charset = "gb2312"
	Mailer.IsHTML = True
	Mailer.username = LoginName	'服务器上有效的用户名
	Mailer.password = LoginPass	'服务器上有效的密码
	Mailer.Priority = 1
	'Mailer.Host = 
	Mailer.Host =MailAddress
	
	Mailer.Port = 25 ' 该项可选.端口25是默认值
	Mailer.From = Fromer   '邮件地址
	Mailer.FromName = SiteNamexx ' 该项可选
	Mailer.AddAddress Email,Email
	Mailer.Subject = Subject
	Mailer.Body = Content
	If Err <> 0 Then
		SendMailb="not_suputted"
	Else
		Mailer.Send
		If Err <> 0 Then
			SendMailb="False"
		Else
			SendMailb="OK"
		End If
	End If
	Set Mailer = Nothing
exit function

end if

	if comtype="CDO.Message" then

	If Not IsObject(cdoConfig) Then
	sch = "http://schemas.microsoft.com/cdo/configuration/"
	Set cdoConfig = Server.CreateObject("CDO.Configuration")
	With cdoConfig.Fields 
		.Item(sch & "smtpserver") = MailAddress		'--SMTP 服务器


		'.Item(sch & "smtpserverport") = 25
		.Item(sch & "sendusing") = 2
		.Item(sch & "smtpaccountname") = SiteNamexx
		.Item(sch & "sendemailaddress") = Fromer
		.Item(sch & "smtpuserreplyemailaddress") = 25
		'.Item(sch & "smtpauthenticate") = cdoBasic
		.Item(sch & "sendusername") = LoginName
		.Item(sch & "sendpassword") = LoginPass
		.update 
	End With
	If Err<>0 Then
		SendMailb="False"
		exit function
	End If


	End If
	

	Set Obj = Server.CreateObject("CDO.Message") 
	With Obj 
		Set .Configuration = cdoConfig 
		.To = Email
		.Subject = Subject
		.TextBody = Content
		.Send
	End With
	Set Obj = Nothing
	Set cdoConfig = Nothing
	If Err<>0 Then
		SendMailb="False"
	Else
		SendMailb="OK"
	End If
exit function

end if

end function







width=100
height=100
function laiyuan()
laiyuan=false
come=Request.ServerVariables("HTTP_REFERER")
here=Request.ServerVariables("SERVER_NAME")
if mid(come,8,len(here))<>here then
laiyuan=false
else
laiyuan=true
end if
end function
laiyuan()
if laiyuan=false then
response.redirect"index.asp"
end if
function ubbg(str)
dim re
	Set re=new RegExp
	re.IgnoreCase=true
	re.Global=True

re.Pattern="(height|javascript|jscript:|js:|value|about:|file:|document.cookie|vbscript:|vbs:|script|width|)"
str=re.Replace(str,"")

re.Pattern="(on(mouse|exit|error|click|key))"
str=re.Replace(str,"")
re.Pattern="(&#)"
str=re.Replace(str,"＆＃")

set re=Nothing
ubbg=str
end function
%>
<!--#include file="up.asp"-->
<style>TABLE {BORDER-TOP: 0px; BORDER-LEFT: 0px; BORDER-BOTTOM: 1px; }TD {BORDER-RIGHT: 0px; BORDER-TOP: 0px;}</style>
<%
function strLength(str)
       ON ERROR RESUME NEXT
       dim WINNT_CHINESE
       WINNT_CHINESE    = (len("论坛")=2)
       if WINNT_CHINESE then
          dim l,t,c
          dim i
          l=len(str)
          t=l
          for i=1 to l
             c=asc(mid(str,i,1))
             if c<0 then c=c+65536
             if c>255 then
                t=t+1
             end if
          next
          strLength=t
       else 
          strLength=len(str)
       end if
       if err.number<>0 then err.clear
end function
noyes="注 册 失 败 ！"
name=Replace(Request.Form("name"),"'","''")


biao2="[ND_sys]"

set rs22=server.CreateObject("adodb.recordset")
rs22.open "select top 1 * from "&biao2&" where type='config_settings'",myconn,1,1

ddd1=rs22("data")
dddd12=split(ddd1,"|")
can_zhu=dddd12(12)
unreg=dddd12(20)
ddian=dddd12(17)
isneedshenhe=dddd12(13)
is_email_pwd=cstr(dddd12(14))
is_only_email=cstr(dddd12(15))
is_sendmail=cstr(dddd12(16))


can=true
goreg=true
if strlength(name)>26 or Instr(name,"=")>0 or Instr(name,"%")>0 or Instr(name,chr(32))>0 or Instr(name,"?")>0 or Instr(name,"&")>0 or Instr(name,";")>0 or Instr(name,",")>0 or Instr(name,"'")>0 or Instr(name,",")>0 or Instr(name,chr(34))>0 or Instr(name,chr(9))>0 or Instr(name,"")>0 or Instr(name,"$")>0 then




can=false
end if



if trim(name)<>"" and trim(request("name"))<>"" then
unregt=split(trim(unreg),",")
for ithi=0 to ubound(unregt)
if instr(1,lcase(trim(request("name"))),lcase(unregt(ithi)),1)<>0 or instr(1,lcase(trim(request("name"))),"'",1)<>0 then
can=false
str=str&"用户名中含有非法字符或含禁止注册的字符!<br>"
exit for
end if

next
end if




if is_only_email="1" then


set rs2c2m=server.CreateObject("adodb.recordset")
rs2c2m.open "select * from [ND_user] where [email]='"&trim(request("em"))&"'",myconn,1,1

if not rs2c2m.eof then
      goreg=false
        mes="此email地址已被一个用户注册,请换一个email地址<br>"
end if
		
end if



	if is_email_pwd="0"  and trim(request("email"))=""  then
      goreg=false
       mes="请输入email地址。<br>"
    End If	





password=Replace(Request.Form("password"),"'","''")
if strlength(password)>16 or Instr(password,"=")>0 or Instr(password,"%")>0 or Instr(password,chr(32))>0 or Instr(password,"?")>0 or Instr(password,"&")>0 or Instr(password,";")>0 or Instr(password,",")>0 or Instr(password,"'")>0 or Instr(password,",")>0 or Instr(password,chr(34))>0 or Instr(password,chr(9))>0 or Instr(password,"")>0 or Instr(password,"$")>0 then
can=false
end if
repassword=Replace(Request.Form("repassword"),"'","''")
nameok=Replace(Request.Form("name")," ","")
passwordok=Replace(Request.Form("password")," ","")
repasswordok=Replace(Request.Form("repassword")," ","")
questionok=Replace(Request.Form("question")," ","")
answerok=Replace(Request.Form("answer")," ","")
email=Replace(Request.Form("email"),"'","''")
set rs=myconn.execute("SELECT*FROM [user] where name='"&name&"'")
if not rs.eof and not rs.bof then
mes="<br>对不起！"&kbbs(name)&" 已被人注册了！！！ <a href='javascript:history.go(-1)'><img border=0 src=pic/re.gif align=absmiddle> 返 回</a><br><br>"
goreg=false
end if
if nameok="" or passwordok="" or repasswordok="" or questionok="" or answerok="" or email="" then
mes="<br>对不起！你不能成功地注册用户！！！请填写完整必填的项目 <a href='javascript:history.go(-1)'><img border=0 src=pic/re.gif align=absmiddle> 返 回</a><br><br>"
goreg=false
end if

function IsValidEmail(email)

 dim names, name, i, c


 IsValidEmail = true
 names = Split(email, "@")
 if UBound(names) <> 1 then
   IsValidEmail = false
   exit function
 end if
 for each name in names
   if Len(name) <= 0 then
     IsValidEmail = false
     exit function
   end if
   for i = 1 to Len(name)
     c = Lcase(Mid(name, i, 1))
     if InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 and not IsNumeric(c) then
       IsValidEmail = false
       exit function
     end if
   next
   if Left(name, 1) = "." or Right(name, 1) = "." then
      IsValidEmail = false
      exit function
   end if
 next
 if InStr(names(1), ".") <= 0 then
   IsValidEmail = false
   exit function
 end if
 i = Len(names(1)) - InStrRev(names(1), ".")
 if i <> 2 and i <> 3 then
   IsValidEmail = false
   exit function
 end if
 if InStr(email, "..") > 0 then
   IsValidEmail = false
 end if

end function
email=request.form("email")
email=server.HTMLEncode(email)

if not IsValidEmail(email) then
mes="<br>对不起！你不能成功地注册用户！！！请检查你的E-mail是否出错！！<a href='javascript:history.go(-1)'><img border=0 src=pic/re.gif align=absmiddle> 返 回</a><br><br>"
goreg=false
end if

if can=false then
mes="<br>你的 用户名 或 密码 含有非法字符或者字符过多！！<a href='javascript:history.go(-1)'><img border=0 src=pic/re.gif align=absmiddle> 返 回</a><br><br>"
goreg=false
end if
if repassword<>password then
mes="<br>你的重复密码与原密码不相同！！<a href='javascript:history.go(-1)'><img border=0 src=pic/re.gif align=absmiddle> 返 回</a><br><br>"
goreg=false
end if



if cstr(can_zhu)<>"1" then
goreg=false
mes="网站暂停了新用户注册，注册操作当前被禁止!<br>"

end if





%>
<%
name=Replace(Request.Form("name"),"'","''")
password=Replace(Request.Form("password"),"'","''")
repassword=Replace(Request.Form("repassword"),"'","''")
question=Replace(Request.Form("question"),"'","''")
answer=Replace(Request.Form("answer"),"'","''")
mypic=Replace(Request.Form("mypic"),"'","''")
mypic=ubbg(mypic)
toupic=Replace(Request.Form("headpic"),"'","''")
email=Replace(Request.Form("email"),"'","''")
home=Replace(Request.Form("home"),"'","''")
sex=Replace(Request.Form("sex"),"'","''")
burn=Replace(Request.Form("burn"),"'","''")
qq=Replace(Request.Form("qq"),"'","''")
gxqm=Request.Form("gxqm")
gxqm=Replace(left(gxqm,255),"'","''")
ch=Replace(Request.Form("ch"),"'","''")
ku=Replace(Request.Form("ku"),"'","''")
mytp=mypic
if mypic="" then
mytp="headpic/"&toupic&".gif"
ch=height
ku=width
end if
if qq<>"" and not isnumeric(qq) then
mes="<br>你的 QQ 填写错误！！<a href='javascript:history.go(-1)'><img border=0 src=pic/re.gif align=absmiddle> 返 回</a><br><br>"
goreg=false
end if
if not isnumeric(ch) or not isnumeric(ku) then
mes="<br>你的图像大小设置错误！！<a href='javascript:history.go(-1)'><img border=0 src=pic/re.gif align=absmiddle> 返 回</a><br><br>"
goreg=false%>
<%else%>
<%if ch>120 or ku>120 then
ch=height
ku=width
end if
end if
%>

<%
if goreg=true then





passworda=md5(password)
answer=md5(answer)
set rs = Server.CreateObject("ADODB.Recordset")
sql="select top 1 * from [nd_user]"
rs.open sql,myconn,1,3
rs.addnew



	        if cstr(isneedshenhe)="1" then
		
		
		rs("user_stutas")="0"
		
		shshstrr=",您的帐户正在等待管理员审核,请等待"	
		else
		rs("user_stutas")="1"
	            shshstrr=""
                           end if





rs("username")=name
dddad=0



	if is_email_pwd="0" then
rs("pwd")=passworda
 else
 
 
Randomize '初始化随机数生成器。
rnddd = cstr(clng(Rnd(255)*99999))&cstr(clng(Rnd(255)*99999)) '产生随机数


If Request.ServerVariables("SERVER_PORT") = "80" Then
			GetSiteUrl = "http://" & Request.ServerVariables("server_name")
		Else
			GetSiteUrl = "http://" & Request.ServerVariables("server_name") & ":" & Request.ServerVariables("SERVER_PORT")
		End If
weerbnamb = GetSiteUrl


Email=trim(request("email"))
Subject="这是您的登陆密码,请注意查收(来自"&weerbnamb&")"
Content="您的登陆密码是"&rnddd&"  ,您注册的用户名是"&trim(name)&","&shshstrr&" (邮件来自"&weerbnamb&")"
restss=SendMailb(Subject, Email, Content)
if restss="not_suputted" then
dddad=1
mes="发送 您的登陆密码到您指定的邮箱时发生错误(原因:服务器不支持邮件发送组件或您未在基本设置里指定邮件发送组件)，注册失败!<br>"
end if

if restss="OK" then
rs("pwd")=md5(rnddd)

end if
if restss="False" then
dddad=1
mes="发送您的登陆密码到您指定的邮箱时发生错误(原因:发送失败,可能您在基本设置里指定的邮件登陆用户名或密码是错误的)，注册失败!<br>"

end if

 
 end if




		
if is_sendmail="1" and trim(request("email"))<>"" then
		
Email=trim(request("email"))
Subject="注册成功,用户名:"&trim(name)&" (来自"&weerbnamb&")"
Content="注册成功,您的登陆密码是"&password&"  ,您注册的用户名是"&trim(name)&","&shshstrr&" (邮件来自"&weerbnamb&")"
restss=SendMailb(Subject, Email, Content)
	
end if








'-----------------------for newd_sys
rs("denglu_count")="0"
rs("uesrclass")="0"
rs("lever_id")=2
rs("nick")=name


rs("pwd_wenti)=question
rs("pwd_daan_md5")=answer
rs("email")=email
rs("home")=home
rs("sex")=sex
rs("burn")=burn
rs("qq")=qq
'rs("toupic")=mytp
rs("touxiang")=mytp

rs("ch")=ch
rs("ku")=ku
rs("gxqm")=gxqm
rs("qian")=1000
rs("meili")=200
rs("jingyan")=200
if dddad=0 then
rs.update
myconn.execute("update [bbsinfo] set newuser='"&name&"',usernum=usernum+1")
noyes="注 册 成 功 "&shshstrr
mes="<br><form method=POST action=bbselse.asp name=login>恭喜你！ <b>"&kbbs(name)&"</b> 成功注册 "&shshstrr&" <input type=hidden name=lgname size=20 value="&name&"><input type=hidden name=lgpwd size=20 value="&password&"><a href='javascript:document.login.submit()'><img border=0 src=pic/go.gif align=absmiddle> 进入论坛</a></form>"
end if



end if
%><!--#include file="mes.asp"--><br><!--#include file="down.asp"-->